Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue31/delcom/Properties.pas

Pascal/Delphi Source File | 1998-02-06 | 21.7 KB | 535 lines

unit Properties;
{********************************************************************}
{**  Unit : Properties                                             **}
{**                                                                **}
{**  Description : This unit contains the main object for the shell**}
{**  extension and the two interface objects needed to implement   **}
{**  a shell extension. The user interface code for the property   **}
{**  page is held in the BMPPageProc                               **}
{**                                                                **}
{**  Version History :                                             **}
{**                                                                **}
{**  A0.01     Initial version started                   27/10/96  **}
{**                                                                **}
{** Copyright ⌐1996 David J. Fiddes                                **}
{********************************************************************}
interface
uses
  Windows, OLE2, ShlObj, ShellAPI, CommCtrl, SysUtils,
  Global, PageDefn, Resource;

type
  TShellExtInit = class; { forward identifiers }
  TPropSheetExt = class;

{********************************************************************}
{**  Object : TPropertiesExt                                       **}
{**                                                                **}
{**  Description : This is the main object for the shell extension.**}
{**  The object contains pointers to the IShellExtInit and         **}
{**  IShellPropSheetExt interfaces and implements most of their    **}
{**  methods.                                                      **}
{**                                                                **}
{**  Version History :                                             **}
{**                                                                **}
{**  A0.01     Initial version started                   27/10/96  **}
{**                                                                **}
{********************************************************************}
  TPropertiesExt = class(IUnknown)

  private
    FRefCount : longint; { reference count for the object }

    ShellExtInit : TShellExtInit; { forward ptr to IShellExtInit interface }
    PropSheetExt : TPropSheetExt; { forward ptr to IShellPropSheetExt interface }

    TheFile      : array[0..MAX_PATH] of char;

  public
    constructor Create;
    destructor Destroy; override;

    {** IUnknown interface **}
    function QueryInterface(const iid: TIID; var obj):HResult; override;
    function AddRef:Longint; override;
    function Release:Longint; override;

    {** IShellExtInit interface implementation **}
    function Initialize( pidlFolder : PItemIDList; lpdobj : IDataObject;
                         hKeyProgID : HKEY): HResult; stdcall;

    {** IShellPropSheetExt interface implementation **}
    function AddPages( lpfnAddPage : TFNAddPropSheetPage; lParam : LPARAM): HResult; stdcall;
    function ReplacePage( uPageID : UINT; lpfnReplaceWith : TFNAddPropSheetPage;
                          lParam : LPARAM): HResult; stdcall;

  end;


{********************************************************************}
{**  Object : TShellExtInit                                        **}
{**                                                                **}
{**  Description : This is the IShellExtInit interface             **}
{**  implementation. It passes most of it's methods back to the    **}
{**  main class object : TPropertiesExt                            **}
{**                                                                **}
{**  Version History :                                             **}
{**                                                                **}
{**  A0.01     Initial version started                   27/10/96  **}
{**                                                                **}
{********************************************************************}
  TShellExtInit = class(IShellExtInit)

  private
    FRefCount : longint; { reference count for the object }
    Parent    : TPropertiesExt; { backpointer to parent }

  public
    constructor Create( AParent : TPropertiesExt );
    destructor Destroy; override;

    {** IUnknown interface **}
    function QueryInterface(const iid: TIID; var obj):HResult; override;
    function AddRef:Longint; override;
    function Release:Longint; override;

    {** IShellExtInit interface implementation **}
    function Initialize( pidlFolder : PItemIDList; lpdobj : IDataObject;
                         hKeyProgID : HKEY): HResult; override;
  end;


{********************************************************************}
{**  Object : TPropSheetExt                                 **}
{**                                                                **}
{**  Description : This is the IShellPropSheetExt interface        **}
{**  implementation. It passes most of it's methods back to the    **}
{**  main class object : TPropertiesExt                            **}
{**                                                                **}
{**  Version History :                                             **}
{**                                                                **}
{**  A0.01     Initial version started                   27/10/96  **}
{**                                                                **}
{********************************************************************}
  TPropSheetExt = class(IShellPropSheetExt)

  private
    FRefCount : longint; { reference count for the object }
    Parent    : TPropertiesExt; { backpointer to parent }

  public
    constructor Create( AParent : TPropertiesExt );
    destructor Destroy; override;

    {** IUnknown interface **}
    function QueryInterface(const iid: TIID; var obj):HResult; override;
    function AddRef:Longint; override;
    function Release:Longint; override;

    {** IShellPropSheetExt interface implementation **}
    function AddPages( lpfnAddPage : TFNAddPropSheetPage; lParam : LPARAM): HResult; override;
    function ReplacePage( uPageID : UINT; lpfnReplaceWith : TFNAddPropSheetPage;
                          lParam : LPARAM): HResult; override;
  end;


{********************************************************************}
implementation

{********************************************************************}
{**  TPropertiesExt implementation                                 **}
{**                                                                **}

{********************************************************************}
{**  Method : TPropertiesExt.Create                                **}
{**                                                                **}
{**  This is the constructor for the main object. It also creates  **}
{**  the two interface classes for the extension in addition to    **}
{**  carrying out the standard reference counting setup.           **}
{********************************************************************}
constructor TPropertiesExt.Create;
begin
  inc(RefThisDLL); { I exist .'. keep me alive! }
  FRefCount:=0; {zero to start - incremented by QueryInterface}

  {** Create the interface classes for later **}
  ShellExtInit:=TShellExtInit.Create(Self);
  PropSheetExt:=TPropSheetExt.Create(Self);

end;


{********************************************************************}
{**  Method : TPropertiesExt.Destroy                               **}
{**                                                                **}
{**  This is the destructor for the main object. It also removes   **}
{**  the two interface classes for the extension and carries out   **}
{**  standard reference counting stripdown.                        **}
{********************************************************************}
destructor TPropertiesExt.Destroy;
begin
  {** zap the interface classes **}
  ShellExtInit.Destroy;
  PropSheetExt.Destroy;

  dec(RefThisDLL);
end;


{********************************************************************}
{**  Method : TPropertiesExt.QueryInterface                        **}
{**                                                                **}
{**  This is method returns a pointer to the requested interface.  **}
{**  IUnknown always returns a pointer to Self. For IShellExtInit  **}
{**  and IShellPropSheetExt it returns the appropriate object ptr. **}
{********************************************************************}
function TPropertiesExt.QueryInterface(const iid: TIID; var obj):HResult;
var
  hr : hResult;
begin
  pointer(obj):=nil;
  hr:=E_NOINTERFACE;

  {** This should only be for us(i.e. not the interface classes **}
  if ISEqualIID(iid,IID_IUnknown) then
  begin
    pointer(obj):=Self;
    hr:=NOERROR;
    AddRef;
  end;

  {** If IShellExtInit interface then chuck pointer!**}
  if ISEqualIID(iid,IID_IShellExtInit) then
  begin
    pointer(obj):=ShellExtInit;
    hr:=NOERROR;
    ShellExtInit.AddRef; { this then calls Self.AddRef }
  end;

  {** If IShellPropSheetExt interface then chuck pointer! **}
  if ISEqualIID(iid,IID_IShellPropSheetExt) then
  begin
    pointer(obj):=PropSheetExt;
    hr:=NOERROR;
    PropSheetExt.AddRef;
  end;

  {** trap nasties **}
  if pointer(obj)=nil then
    hr:=E_NOINTERFACE;

  QueryInterface:=hr;
end;


{********************************************************************}
{**  Method : TPropertiesExt.AddRef                                **}
{**                                                                **}
{**  This is method increments the reference count for this object **}
{********************************************************************}
function TPropertiesExt.AddRef:longint;
begin
  inc(FRefCount);
  Result:=FRefCount;
end;


{********************************************************************}
{**  Method : TPropertiesExt.Release                               **}
{**                                                                **}
{**  This is method decrements the reference count for this object **}
{**  if it is zero it unloads the object.                          **}
{********************************************************************}
function TPropertiesExt.Release:longint;
begin
  dec(FRefCount);
  Result:=FRefCount;
  if FRefCount=0 then Free;
end;


{********************************************************************}
{**  Method : TPropertiesExt.Initialize                            **}
{**                                                                **}
{**  This is method is called to setup the shell extension, findout**}
{**  the files involved,etc. At the moment it does nothing....     **}
{**  Bounced IShellExtInit::Initialize implementation.             **}
{********************************************************************}
function TPropertiesExt.Initialize( pidlFolder : PItemIDList; lpdobj : IDataObject;
                                       hKeyProgID : HKEY): HResult;
var
  medium : TStgMedium;
  fe     : TFormatEtc;
  hr     : HResult;
begin
  FillChar(TheFile,sizeof(TheFile),0);
  { Fill in the fe structure }
  with fe do
  begin
    cfFormat:=CF_HDROP;
    ptd:=nil;
    dwAspect:=DVASPECT_CONTENT;
    lindex:=-1;
    tymed:=TYMED_HGLOBAL;
  end;

  if lpdobj=nil then
  begin
    Result:=E_FAIL;
    exit;
  end;

  {** Render the data referenced by the IDataObject pointer to an HGLOBAL **}
  {** storage medium in CF_HDROP format.                                  **}

  hr:=lpdobj.GetData(fe,medium);
  if FAILED(hr) then
  begin
    Result:=E_FAIL;
    exit;
  end;

  {** If only one file is selected, retrieve the file name and store it in **}
  {** m_szFile. Otherwise fail the call.                                   **}

  hr:=E_FAIL;

  if DragQueryFile(medium.hGlobal,-1,nil,0)=1 then
  begin
    DragQueryFile(medium.hGlobal,0,TheFile,sizeof(TheFile));
    hr:=NO_ERROR;
  end;

  {** Release the storage medium and return. **}
  ReleaseStgMedium(medium);

  Result:=hr;
end;


{********************************************************************}
{**  Method : TPropertiesExt.AddPages                              **}
{**                                                                **}
{**  This is method is called to add pages to the PropertySheet.   **}
{**  This sets up a simple page which is dealt with by the dialog/ **}
{**  callback functions in BMPPageProc                             **}
{**  Bounced IShellPropSheetExt::AddPages implementation.          **}
{********************************************************************}
function TPropertiesExt.AddPages( lpfnAddPage : TFNAddPropSheetPage; lParam : LPARAM): HResult;
var
  psp   : TPropSheetPage;
  hPage : hPropSheetPage;
  FileStr : PChar;
begin
  {allocate memory for the filename and copy}
  GetMem(FileStr,MAX_PATH+1);
  StrCopy(FileStr,TheFile);

  FillChar(psp,sizeof(psp),0); { make sure it's clean }
  with psp do
  begin
    dwSize:=sizeof(TPropSheetPage);
    dwFlags:=PSP_USEREFPARENT OR PSP_USECALLBACK;
    psp.hInstance:=system.hInstance;
    pszTemplate:=MakeIntResource(Dlg_Details);
    pfnDlgProc:=@PropExtDlgProc; { for the user interface stuff }
    pfnCallback:=@PropExtCallback; { for setup - shutdown functions }
    pcRefParent:=@RefThisDLL;
    lParam:=longint(FileStr);{pass in string pointer}
  end;

  hPage:=CreatePropertySheetPage(psp);
  if hPage<>nil then { valid PropertySheetPage }
    if not lpfnAddPage(hPage,lParam) then {add the page and check for OK}
      DestroyPropertySheetPage(hPage);

  Result:=NOERROR;
end;


{********************************************************************}
{**  Method : TPropertiesExt.ReplacePage                           **}
{**                                                                **}
{**  This is method is called to replacepages to the PropertySheet.**}
{**  This is not required for anything other than ControlPanel apps**}
{**  Bounced IShellPropSheetExt::ReplacePages implementation.      **}
{********************************************************************}
function TPropertiesExt.ReplacePage( uPageID : UINT; lpfnReplaceWith : TFNAddPropSheetPage;
                                        lParam : LPARAM): HResult;
begin
  Result:=E_NOTIMPL; {we don't do ReplacePages so be honest!}
end;


{********************************************************************}
{**  TShellExtInit implementation                                  **}
{**                                                                **}

{********************************************************************}
{**  Method : TShellExtInit.Create                                 **}
{**                                                                **}
{**  This is the constructor for the IShellExtInit interface       **}
{**  object. This object carries out it's own ref. counting        **}
{********************************************************************}
constructor TShellExtInit.Create( AParent : TPropertiesExt );
begin
  FRefCount:=0; {zero to start - incremented by QueryInterface}
  Parent:=AParent; { store pointer }
end;


{********************************************************************}
{**  Method : TShellExtInit.Destroy                                **}
{**                                                                **}
{**  This is the destructor for the IShellExtInit interface        **}
{**  object.                                                       **}
{********************************************************************}
destructor TShellExtInit.Destroy;
begin
end;


{********************************************************************}
{**  Method : TShellExtInit.QueryInterface                         **}
{**                                                                **}
{**  This is method delegates to it's parent which returns the     **}
{**  appropriate pointer.                                          **}
{********************************************************************}
function TShellExtInit.QueryInterface(const iid: TIID; var obj):HResult;
begin
  QueryInterface:=Parent.QueryInterface(iid,obj);
end;


{********************************************************************}
{**  Method : TShellExtInit.AddRef                                 **}
{**                                                                **}
{**  This is method increments the reference count.                **}
{********************************************************************}
function TShellExtInit.AddRef:longint;
begin
  Parent.AddRef;
  inc(FRefCount);
  Result:=FRefCount;
end;


{********************************************************************}
{**  Method : TShellExtInit.Release                                **}
{**                                                                **}
{**  This is method decrements the reference count and if zero     **}
{**  unloads the object.                                           **}
{********************************************************************}
function TShellExtInit.Release:longint;
begin
  Parent.Release;
  dec(FRefCount);
  Result:=FRefCount;
end;


{********************************************************************}
{**  Method : TShellExtInit.Initialize                             **}
{**                                                                **}
{**  This is method is passed onto TPropertiesExt.Initialize       **}
{********************************************************************}
function TShellExtInit.Initialize( pidlFolder : PItemIDList; lpdobj : IDataObject;
                                       hKeyProgID : HKEY): HResult;
begin
  Result:=Parent.Initialize(pidlFolder,lpdobj,hKeyProgID);
end;


{********************************************************************}
{**  TPropSheetExt implementation                           **}
{**                                                                **}

{********************************************************************}
{**  Method : TPropSheetExt.Create                          **}
{**                                                                **}
{**  This is the constructor for the IShellPropSheetExt interface  **}
{**  object. This object carries out it's own ref. counting        **}
{********************************************************************}
constructor TPropSheetExt.Create( AParent : TPropertiesExt );
begin
  FRefCount:=0; {zero to start - incremented by QueryInterface}
  Parent:=AParent; { store pointer }
end;


{********************************************************************}
{**  Method : TPropSheetExt.Destroy                         **}
{**                                                                **}
{**  This is the destructor for the IShellPropSheetExt interface   **}
{**  object.                                                       **}
{********************************************************************}
destructor TPropSheetExt.Destroy;
begin
end;


{********************************************************************}
{**  Method : TPropSheetExt.QueryInterface                  **}
{**                                                                **}
{**  This is method delegates to it's parent which returns the     **}
{**  appropriate pointer.                                          **}
{********************************************************************}
function TPropSheetExt.QueryInterface(const iid: TIID; var obj):HResult;
begin
  QueryInterface:=Parent.QueryInterface(iid,obj);
end;


{********************************************************************}
{**  Method : TPropSheetExt.AddRef                          **}
{**                                                                **}
{**  This is method increments the reference count.                **}
{********************************************************************}
function TPropSheetExt.AddRef:longint;
begin
  inc(FRefCount);
  Result:=FRefCount;
  Parent.AddRef;
end;


{********************************************************************}
{**  Method : TPropSheetExt.Release                         **}
{**                                                                **}
{**  This is method decrements the reference count and if zero     **}
{**  unloads the object.                                           **}
{********************************************************************}
function TPropSheetExt.Release:longint;
begin
  dec(FRefCount);
  Result:=FRefCount;
  Parent.Release;
end;


{********************************************************************}
{**  Method : TPropSheetExt.AddPages                        **}
{**                                                                **}
{**  This is method is passed onto TPropertiesExt.AddPages         **}
{********************************************************************}
function TPropSheetExt.AddPages( lpfnAddPage : TFNAddPropSheetPage; lParam : LPARAM): HResult;
begin
  Result:=Parent.AddPages(lpfnAddPage,lParam);
end;


{********************************************************************}
{**  Method : TPropSheetExt.ReplacePAge                     **}
{**                                                                **}
{**  This is method is passed onto TPropertiesExt.ReplacePage      **}
{********************************************************************}
function TPropSheetExt.ReplacePage( uPageID : UINT; lpfnReplaceWith : TFNAddPropSheetPage;
                                        lParam : LPARAM): HResult;
begin
  Result:=Parent.ReplacePage(uPageID,lpfnReplaceWith,lParam);
end;


end.
{********************************************************************}